module XI.Directory.GetXiObj where

import XI.Directory.WS.Xmlable(WsParams (..))
import qualified CommunicationChannelService as CC 
import qualified SenderAgreementService as SA
import qualified ReceiverAgreementService as RA
import qualified ReceiverDeterminationService as RD
import qualified InterfaceDeterminationService as ID
import qualified ConfigurationScenarioService as CS
import qualified IntegrationProcessService as IP
import Data.Maybe
import Data.List
--import Control.Applicative
import XI.Directory.Types

getQueryResult wsp ws c1 c2 = ws wsp . c2 . Just . c1 Nothing Nothing $ Nothing
getReadResult wsp ws c1 c2 xs = ws wsp . c2 . Just . c1 . Just $ xs
parseResult f1 f2 x = maybeToList (f1 x) >>= concat . maybeToList . f2

getList wsp ws c1 c2 f1 f2 = getQueryResult wsp ws c1 c2 >>= return . parseResult f1 f2
getDescList wsp ws c1 c2 f1 f2 xs = getReadResult wsp ws (c1 Nothing) c2 xs >>= return . parseResult f1 f2
getXiList wsp wsq cq1 cq2 fq1 fq2 wsr cr1 cr2 fr1 fr2 getObj = 
	getList wsp wsq cq1 cq2 fq1 fq2 >>= getDescList wsp wsr cr1 cr2 fr1 fr2 >>= return . sort . concatMap getObj
	
getCC :: WsParams -> IO [XIObj]
getCC wsp = getXiList wsp CC.query CC.CC_QueryIn CC.QueryInput CC.responseQueryOutput CC.ccqoCC_ID
						CC.read CC.CC_ReadIn CC.ReadInput CC.responseReadOutput CC.ccroCommunicationChannel
						getCCObj

getSA :: WsParams -> IO [XIObj]
getSA wsp = getXiList wsp SA.query SA.SA_QueryIn SA.QueryInput SA.responseQueryOutput SA.saqoSA_ID
						SA.read SA.SA_ReadIn SA.ReadInput SA.responseReadOutput SA.saroSenderAgreement
						getSAObj

getRA :: WsParams -> IO [XIObj]
getRA wsp = getXiList wsp RA.query RA.RA_QueryIn RA.QueryInput RA.responseQueryOutput RA.raqoRA_ID
						RA.read RA.RA_ReadIn RA.ReadInput RA.responseReadOutput RA.raroReceiverAgreement
						getRAObj
						
getRD :: WsParams -> IO [XIObj]
getRD wsp = getXiList wsp RD.query RD.RD_QueryIn RD.QueryInput RD.responseQueryOutput RD.rdqoRD_ID
						RD.read RD.RD_ReadIn RD.ReadInput RD.responseReadOutput RD.rdroReceiverDetermination
						getRDObj
						
getID :: WsParams -> IO [XIObj]
getID wsp = getXiList wsp ID.query ID.ID_QueryIn ID.QueryInput ID.responseQueryOutput ID.idqoID_ID
						ID.read ID.ID_ReadIn ID.ReadInput ID.responseReadOutput ID.idroInterfaceDetermination
						getIDObj
						
getIP :: WsParams -> IO [XIObj]
getIP wsp = getXiList wsp IP.query IP.IP_QueryIn IP.QueryInput IP.responseQueryOutput IP.ipqoIP_ID
						IP.read IP.IP_ReadIn IP.ReadInput IP.responseReadOutput IP.iproIntegrationProcess
						getIPObj
						
getCS :: WsParams -> IO [XIObj]
getCS wsp = getXiList wsp CS.query CS.CS_QueryIn CS.QueryInput CS.responseQueryOutput CS.csqoCS_ID
						CS.read CS.CS_ReadIn CS.ReadInput CS.responseReadOutput CS.csroConfigurationScenario
						getCSObj
						
getCCObj desc = maybeToList $ do
	ccid <- CC.ccCC_ID desc
	sys <- CC.ccidComponentID ccid
	cc <- CC.ccidChannelID ccid
	d <- CC.ccDirection desc
	am <- CC.ccAdapterMetadata desc
	amn <- CC.doidName am
	return CC {	cc_system = sys,
							cc_name = cc,
                            cc_param = (ccType d, readAT amn) }

getSAObj desc = maybeToList $ do
	said <- SA.saSA_ID desc
	sys <- SA.mhidSC_ID said
	inm <- SA.mhidInterfaceName said
	ins <- SA.mhidInterfaceNamespace said
	ccid <- SA.saCommunicationChannel desc
	cc <- SA.ccidChannelID ccid
	return SAgg {	sender = sys,
					sender_int = (ins ++ "/" ++ inm),
					sender_cc = cc }

getRAObj desc = maybeToList $ do
	raid <- RA.raRA_ID desc
	ssys <- RA.mhidSC_ID raid
	sys <- RA.mhidRC_ID raid
	inm <- RA.mhidInterfaceName raid
	ins <- RA.mhidInterfaceNamespace raid
	ccid <- RA.raCommunicationChannel desc
	cc <- RA.ccidChannelID ccid
	return RAgg {	sender = ssys,
					receiver = sys,
					receiver_int = (ins ++ "/" ++ inm),
					receiver_cc = cc }

getRDObj desc = do	
	rdid <- maybeToList $ RD.rdRD_ID desc
	ssys <- maybeToList $ RD.mhidSC_ID rdid
	inm <- maybeToList $ RD.mhidInterfaceName rdid
	ins <- maybeToList $ RD.mhidInterfaceNamespace rdid
	rdr <- maybeToList $ RD.rdRule desc
	return $ RD ssys (ins ++ "/" ++ inm) $ sort $ do
		rdr' <- rdr
		rdrr <- maybeToList $ RD.rdrReceiver rdr' 
		rdrr' <- rdrr
		ext <- maybeToList $ RD.cpeCommunicationComponent rdrr'
		val <- maybeToList $ RD.eValue ext
		return (Nothing, val)

getIDObj desc = do
	idid <- maybeToList $ ID.idID_ID desc
	ssys <- maybeToList $ ID.mhidSC_ID idid
	inm  <- maybeToList $ ID.mhidInterfaceName idid
	ins  <- maybeToList $ ID.mhidInterfaceNamespace idid
	rsys <- maybeToList $ ID.mhidRC_ID idid
	rule <- maybeToList $ ID.idRule desc
	return $ ID ssys (ins ++ "/" ++ inm) rsys $ sort $ do
		rule' <- rule
		int   <- maybeToList $ ID.idrInterface rule'
		int'  <- int
		ininm <- maybeToList $ ID.doidName int'
		inins <- maybeToList $ ID.doidNamespace int'
		return (Nothing, (inins ++ "/" ++ ininm), do
				mp <- ID.idrMapping rule'
				mpnm <- ID.doidName mp
				mpns <- ID.doidNamespace mp
				return (mpns ++ "/" ++ mpnm)
			)

getIPObj desc = do
  ipid <- maybeToList $ IP.ipIP_ID desc
  ip <- maybeToList $ IP.ccmpidCI_D ipid
  return IP {system = ip}


getCSObj desc = do
	csid <- maybeToList $ CS.csCS_ID desc
	return $ Sc csid $ sort ( 
		do
			cc 		<- concat $ maybeToList $ CS.csCommunicationChannel desc
			sys		<- maybeToList $ CS.ccidComponentID cc
			ccid	<- maybeToList $ CS.ccidChannelID cc
			return ("CC|" ++ sys ++ "|" ++ ccid)
		++ 
		do
			sa 	<- concat $ maybeToList $ CS.csSenderAgreement desc
			sys	<- maybeToList $ CS.mhidSC_ID sa
			ns 	<- maybeToList $ CS.mhidInterfaceNamespace sa
			nm 	<- maybeToList $ CS.mhidInterfaceName sa
			return $ "SAGG|" ++ sys ++ "|" ++ ns ++ "/" ++ nm
		++ 
		do
			ra 	<- concat $ maybeToList $ CS.csReceiverAgreement desc
			ssys<- maybeToList $ CS.mhidSC_ID ra
			sys	<- maybeToList $ CS.mhidRC_ID ra
			ns 	<- maybeToList $ CS.mhidInterfaceNamespace ra
			nm 	<- maybeToList $ CS.mhidInterfaceName ra
			return $ "RAGG|" ++ ssys ++ "|" ++ sys ++ "|" ++ ns ++ "/" ++ nm
		++ 
		do
			rd 	<- concat $ maybeToList $ CS.csReceiverDetermination desc
			sys	<- maybeToList $ CS.mhidSC_ID rd
			ns 	<- maybeToList $ CS.mhidInterfaceNamespace rd
			nm 	<- maybeToList $ CS.mhidInterfaceName rd
			return $ "RD|" ++ sys ++ "|" ++ ns ++ "/" ++ nm
		++ 
		do
			id 	<- concat $ maybeToList $ CS.csInterfaceDetermination desc
			ssys	<- maybeToList $ CS.mhidSC_ID id
			rsys	<- maybeToList $ CS.mhidRC_ID id
			ns 	<- maybeToList $ CS.mhidInterfaceNamespace id
			nm 	<- maybeToList $ CS.mhidInterfaceName id
			return $ "ID|" ++ ssys ++ "|" ++ ns ++ "/" ++ nm ++ "|" ++ rsys
		)